functor DeadCode (S : DEAD_CODE_STRUCTS) : DEAD_CODE =
struct
  open S
  
  structure I = Ir
  structure ErrorMsg = ErrorMsg
  
  local open I
  in structure Id = I.Id
     structure Intl = I.Intl
     structure B = I.Binop
     structure T = I.Types
     structure L = I.Le
     structure S = I.Structs
     structure M = I.Stm
     structure F = I.Function
     structure P = I.Program
  end

  val error = ErrorMsg.error

  val tag = false
  fun debugPrint s = 
      if tag
      then print (String.concat [s, "\n"])
      else ()
  
  val doAgain = ref false
  
  fun cfStm s =
      case s
       of M.AsnExp {lval, exp, ty, pos} => s
        | M.AsnCall {lval, fid, ty, exps, pos} => s
        | M.AsnAlloc {lval, ty, pos} => s
        | M.If (e, ss1, ss2, pos) =>
          M.If (e, cfStms ss1, cfStms ss2, pos)
        | M.While {invariant, condition, body, pos} =>
          if M.endWithReturns body
          then M.If (condition, cfStms body, [], pos)
          else M.While {invariant = invariant,
                        condition = condition,
                        body = cfStms body,
                        pos = pos}
        | _ => s
    and cfStms ss =
        case ss
         of [] => []
          | [x] => [cfStm x]            
          | x :: xs =>
            if M.endWithReturn x
            then let val _ = doAgain := true
                 in  [cfStm x]
                 end
            else (cfStm x) :: (cfStms xs)
        
    fun shrinkStms ss =
        let val ss = cfStms ss
        in  if !doAgain
            then (doAgain := false; shrinkStms ss)
            else ss
        end
    
    fun shrinkFun f =
        case f
       of F.T {name,
               rettype,
               args,
               locals,
               stm,
               pre,
               post,
               pos} => 
          F.T {name = name,
               rettype = rettype,
               args = args,
               locals = locals,
               stm = shrinkStms stm,
               pre = pre,
               post = post,
               pos = pos}
        
  fun shrinkProg p =
      case p
       of P.T {structs,
               gvars,
               funcs,
               pos} =>
          P.T {structs = structs,
               gvars = gvars,
               funcs = List.map shrinkFun funcs,
               pos = pos}
               
  fun shrink p =
      let val _ = if tag
                  then File.output ("deadcodeIr1.c", P.toString p)
                  else ()
          val new = shrinkProg p
          val _ = if tag
                  then File.output ("deadcodeIr2.c", P.toString new)
                  else ()
      in  new
      end
end
